Main

Sub Main
	dim viaType
	viaType =""
	dim doc
	set doc = Application.ActiveDocument
	
	dim objs,obj
	set objs = doc.GetObjects(4,,true)
	for each obj in objs
		viaType= obj.Type 
		exit for
	next
	'if viaType="" then exit sub

	
	dim ws : set ws = CreateObject("WScript.Shell")
	dim varName : varName = "CVV"
	dim regPath : regPath ="HKEY_CURRENT_USER\Software\MyApp\PADS\" & varName
	dim varValue : varValue = ws.RegRead(regPath)
	Application.StatusBarText =""
	
	dim ostr
	select case varValue
		case 0
			varValue = 1
			dim endLayer
			endLayer = doc.ElectricalLayerCount-1
			endLayer = "L" & cstr(endLayer)
			'msgbox endLayer
			Application.StatusBarText = "Change to TH Vias"
			ws.RegWrite regPath, varValue, "REG_EXPAND_SZ"
			ostr = "Application.ExecuteCommand(""Properties"")" & chr(13) & chr(10)
			ostr = ostr & "ViaPropertiesDlg.PadStack.Click()" & chr(13) & chr(10)
			ostr = ostr & "PadStacksPropertiesDlg.ThroughOrPartial = 1" & chr(13) & chr(10)
			ostr = ostr & "PadStacksPropertiesDlg.ViaStartLayer = ""L2""" & chr(13) & chr(10)
			ostr = ostr & "PadStacksPropertiesDlg.ViaEndLayer = """ & endLayer & """" & chr(13) & chr(10)
			ostr = ostr & "PadStacksPropertiesDlg.Ok.Click()" & chr(13) & chr(10)
			ostr = ostr & "DlgPrompt.Question(""Are you sure you want to change all vias of type " & viaType & "?"").Answer(mbYes)" & chr(13) & chr(10)
			ostr = ostr & "DlgPrompt.Question(""Connectivity of some traces can be lost. Continue?"").Answer(mbYes)" & chr(13) & chr(10)
			ostr = ostr & "ViaPropertiesDlg.Ok.Click()"
		case 1
			varValue = 0
			Application.StatusBarText = "Change to Buried Vias"
			ws.RegWrite regPath, varValue, "REG_EXPAND_SZ"
			ostr = "Application.ExecuteCommand(""Properties"")" & chr(13) & chr(10)
			ostr = ostr & "ViaPropertiesDlg.PadStack.Click()" & chr(13) & chr(10)
			ostr = ostr & "PadStacksPropertiesDlg.ThroughOrPartial = 0" & chr(13) & chr(10)
			ostr = ostr & "PadStacksPropertiesDlg.Ok.Click()" & chr(13) & chr(10)
			ostr = ostr & "DlgPrompt.Question(""Are you sure you want to change all vias of type " & viaType & "?"").Answer(mbYes)" & chr(13) & chr(10)
			ostr = ostr & "ViaPropertiesDlg.Ok.Click()"
	end select
	
	dim tmpfile
	tmpfile = doc.path & "\tmp1.mcr"
	Dim fso,fw
	Set fso = CreateObject("scripting.filesystemobject")
	Set fw = fso.CreateTextFile(tmpfile,True)
	fw.Write ostr
	fw.close
	Set fw = Nothing	
	Set fso = Nothing			
	application.RunMacro(tmpfile)
	set ws = nothing
	msgbox "done"
End Sub

Function RegexSplit(expression, delimiter)
	dim isGotoTheEnd : isGotoTheEnd = false
	
	Dim regex, matches, arr(), i
	dim default_delimiter : default_delimiter= "@"
	dim tmpstr :tmpstr = "###!!!###!!!"
	if delimiter=default_delimiter then	
	else
		if instr(expression,default_delimiter)=0 then
			expression = replace(expression,delimiter,default_delimiter)
		else
			if instr(expression,tmpstr)=0 then
				expression = replace(expression,default_delimiter,tmpstr)
				expression = replace(expression,delimiter,default_delimiter)
			else
				msgbox "UnSupport ( conflict string )"
				ReDim arr(0)
				arr(0) = expression
				isGotoTheEnd = true
			end if			
		end if	
	end if
	'Continue	
	if isGotoTheEnd = false then
		dim len_expression :len_expression =len(expression)		
		Set regex = CreateObject("VBScript.RegExp") 
		regex.Pattern = default_delimiter
		regex.Global = True
		Set matches = regex.Execute(expression)
		dim ncount
		ncount = matches.Count+1
		ReDim arr(matches.Count)
		If ncount = 0 Then
			arr(0) = expression			
		else
			dim l_index,u_index,ul_len
			l_index = 0	
			For i = 0 To matches.Count - 1
				u_index = matches(i).FirstIndex-1
				ul_len = u_index-l_index+1
				arr(i) = Mid(expression, l_index, ul_len)
				l_index = matches(i).FirstIndex+1
			next
			'last item
			ul_len=len_expression - l_index
			arr(i) = Mid(expression, l_index, ul_len)
		end if
		'The End
		For i = 0 To UBound(arr)
			arr(cint(i)) = replace(arr(cint(i)),tmpstr,default_delimiter)
		Next
	end if	
    RegexSplit = arr
End Function
